(module queue mzscheme
  (provide 
   queue-empty?
   queue-insert
   queue-insert-last
   queue-remove
   queue-remove-first
   queue-first
   queue-elements
   ; queue-fold
   )
  
  (require (lib "etc.ss")
           (prefix list: (lib "list.ss"))
           (lib "unitsig.ss")
           "../queue.ss")

  ; A general queue consists of a "vector" of methods, a size and a specialized
  ; representation of the set.

  (define-struct <queue> 
    (methods   ;  methods
     queue       ; the specialized representation
     ))

  (define (queue? o) (<queue>? o))
  
  (define-struct queue-methods 
    ; IMPORTANT: When adding more methods, remember to add a keyword in 'call' below
    (empty? insert insert-last remove remove-first  first elements fold))

  ; (call method-name methods . arguments) 
  ;   sugar coats the method calls
  (define-syntax call
    (syntax-rules (empty? insert insert-last remove remove-first  first elements fold)
      ((call m empty?       s)     ((queue-methods-empty?                 m) s))
      ((call m insert       s x)   ((queue-methods-insert                 m) s x))
      ((call m insert-last  s x)   ((queue-methods-insert-last            m) s x))
      ((call m remove       s)     ((queue-methods-remove                 m) s))
      ((call m remove-first s)     ((queue-methods-remove-first           m) s))
      ((call m first        s)     ((queue-methods-first                  m) s))
      ((call m elements     s)     ((queue-methods-elements               m) s))
      ((call m fold         s f i) ((queue-methods-fold                   m) s f i))
      ((_ . more)                
       (error "call: unknown <queue> method: " '(call . more)))))

    
  (define make-queue
    (opt-lambda ([queue@ queue@])
      (use-queue queue@)
      (make-<queue> (make-queue-methods empty? insert insert-last remove remove-first  first elements fold)
                    empty)))
  
  (define-syntax with-queue 
    (syntax-rules ()
      [(with-queue () body)              body]
      [(with-queue ((s m d)) body)       (let ((m (<queue>-methods s))
                                               (d (<queue>-queue s)))
                                           body)]
      [(with-queue ((s m d) . more) body)  (with-set ((s m d))
                                                     (with-queue more
                                                                 body))]))
  
  (define (queue-empty? q)            (with-queue ((q m d)) (call m empty? d)))
  (define (queue-insert q x)          (with-queue ((q m d)) (make-<queue> m (call m insert d x))))
  (define (queue-insert-last q x)     (with-queue ((q m d)) (make-<queue> m (call m insert-last d x))))
  (define (queue-remove q)            (with-queue ((q m d)) (make-<queue> m (call m remove d))))
  (define (queue-remove-first q)      (with-queue ((q m d)) (make-<queue> m (call m remove-first d))))
  (define (queue-first q)             (with-queue ((q m d)) (call m first d)))
  (define (queue-elements q)          (with-queue ((q m d)) (call m elements d)))
;  (define (queue-fold fn init q)      (with-queue ((q m d)) (call m empty? d)))
  (define (queue-xinsert x q) (queue-insert q x))
  
  
  (define (test)
    (define empty-queue (make-queue))
    (printf 
     "~a~n"
     (queue-elements (queue-remove (queue-remove (list:foldl queue-xinsert empty-queue '(1 2 3 4)))))))
  (test)
)  